home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d3 / edit1234.arc / CARDS.BAS next >
BASIC Source File  |  1991-04-28  |  21KB  |  726 lines
  1. '========  QB4 Source Code for CHRISTMAS CARDS =======
  2. DECLARE SUB AlphaSort ()
  3. DECLARE SUB Bottom (Text$)
  4. DECLARE SUB Center (Down%, Text$)
  5. DECLARE SUB DatInput ()
  6. DECLARE SUB EditOvl ()
  7. DECLARE SUB FileSelectScrn ()
  8. DECLARE SUB Frame (Row%, LRow%, Col%, Box%)
  9. DECLARE SUB GetEditor (Edit$)
  10. DECLARE SUB HelpFile ()
  11. DECLARE SUB InputScrn ()
  12. DECLARE SUB Logon ()
  13. DECLARE SUB MenuScrn ()
  14. DECLARE SUB PrintScrn ()
  15. DECLARE SUB QSearch (Search$, CaseSen%, RecFind%)
  16. DECLARE SUB Spot (Down%, Over%)
  17. DECLARE SUB Upper (Text$)
  18. DECLARE SUB WrongFileScrn ()
  19. COMMON SHARED x%, rn%, TotRec%, RecLen%, File$
  20. Logon
  21. ON KEY(10) GOSUB EndProgram
  22. KEY(10) ON
  23. TYPE CardRecord
  24.      Last AS STRING * 15
  25.      First AS STRING * 20
  26.      Addr AS STRING * 25
  27.      City AS STRING * 12
  28.      State AS STRING * 2
  29.      Zip AS STRING * 10
  30.      Remk AS STRING * 50
  31.      CarrRetn AS STRING * 2
  32. END TYPE
  33. DIM SHARED Easy AS CardRecord
  34. DIM SHARED Alpha(200) AS CardRecord
  35. ON ERROR GOTO ErrorProc
  36.  
  37. File$ = "cards.dat"
  38. Page$ = "Cards-"
  39. Header$ = "RECORD OF CARDS SENT AND RECEIVED"
  40. SubHead$ = "Viola and George Jones"
  41.  
  42. Menu:
  43. CLOSE
  44. DO
  45. MenuScrn
  46. DO
  47. a$ = UCASE$(INPUT$(1))
  48. SELECT CASE a$
  49.    CASE IS = "C"
  50.       GOSUB CreateFile
  51.    CASE IS = "F"
  52.       GOSUB SelectFile
  53.    CASE IS = "H"
  54.       HelpFile
  55.    CASE IS = "L"
  56.       GOSUB SetScreen
  57.    CASE IS = "P"
  58.       GOSUB DataPrint
  59.    CASE IS = "X"
  60.       GOSUB EndProgram
  61.    CASE ELSE
  62. END SELECT
  63. LOOP WHILE INSTR("CFHLPX", a$) = 0
  64. LOOP
  65.  
  66. CreateFile:
  67. IF File$ = "cardssrt.dat" THEN GOSUB WrongFile
  68. GOSUB OpenFile
  69. rn% = TotRec% + 1
  70. DO WHILE Easy.Last <> ""
  71. DatInput
  72. Center 1, " For each Field »» Type Data - then press <enter>."
  73. Spot 2, 1: Center 1, "To Exit - Press <Enter> at next blank LAST NAME Space."
  74. Spot 2, 1: Center 1, "╡  Do Not Exceed Highlighted Space  ╞"
  75. x% = 17: LOCATE x%, 6: LINE INPUT Easy.Last
  76.    IF Easy.Last = STRING$(15, " ") THEN
  77.       rn% = rn% - 2
  78.       GOSUB DispName
  79.    END IF
  80. LOCATE x%, 36: LINE INPUT Easy.First: Spot 2, 6: LINE INPUT Easy.Addr
  81. Spot 2, 6: LINE INPUT Easy.City: LOCATE x%, 31: LINE INPUT Easy.State
  82. LOCATE x%, 46: LINE INPUT Easy.Zip: Spot 2, 6: LINE INPUT Easy.Remk
  83. Easy.CarrRetn = CHR$(13) + CHR$(10)
  84. PUT #1, rn%, Easy
  85. rn% = rn% + 1
  86. LOOP
  87.  
  88. SetScreen:
  89. COLOR 1, 1, 8: CLS : Upper "V I E W   T H E   F I L E  " + File$
  90. Frame 8, 16, 8, 3
  91. GOSUB OpenFile
  92. Center 8, "╔═THE FILE CONTAINS" + STR$(TotRec%) + " RECORDS ═╗"
  93. Center 2, "LIST STARTING AT RECORD NUMBER "
  94. INPUT rn%
  95. IF rn% > TotRec% THEN rn% = TotRec%
  96.  
  97. DispName:
  98. COLOR 0, 3, 8: CLS : Bottom "VIEWING THE FILE"
  99. GOSUB OpenFile
  100. IF rn% <= 0 THEN rn% = 1
  101. Cnt% = 1
  102. FOR rn% = rn% TO TotRec%
  103. PRINT TAB(58); : COLOR 15, 0: PRINT rn%: COLOR 0, 3
  104. GET #1, rn%, Easy
  105. PRINT TAB(24); RTRIM$(Easy.Last); ", "; Easy.First
  106. PRINT TAB(24); Easy.Addr
  107. PRINT TAB(24); RTRIM$(Easy.City); ", "; Easy.State; ", "; Easy.Zip
  108. PRINT TAB(24); Easy.Remk
  109.    IF Cnt% >= 4 THEN
  110.       Cnt% = 1
  111.       rn% = rn% + 1
  112.       EXIT FOR
  113.    END IF
  114. Cnt% = Cnt% + 1
  115. NEXT
  116.  
  117. x% = 22: COLOR 0, 6
  118. Center 1, "╠══LIST══EDIT══SEARCH═SORT══OR══MENU - L / E / * / M / S ══╣"
  119.    IF rn% >= TotRec% + 1 THEN
  120.       COLOR 14, 0: Center 2, "{{ LAST ITEM - PRESS  » M «  }}"
  121.    END IF
  122. DO
  123. COLOR 0, 3
  124. a$ = UCASE$(INPUT$(1))
  125.    SELECT CASE a$
  126.       CASE IS = "L"
  127.          GOSUB DispName
  128.       CASE IS = "E"
  129.          GOSUB Editor
  130.       CASE IS = "*"
  131.          GOSUB DataSort
  132.          RETURN Menu
  133.       CASE IS = "M"
  134.          RETURN Menu
  135.       CASE IS = "S"
  136.          GOSUB TextSearch
  137.       CASE ELSE
  138.    END SELECT
  139. LOOP WHILE INSTR("LE*MS", a$) = 0
  140.  
  141. Editor:
  142. IF File$ = "cardssrt.dat" THEN GOSUB WrongFile
  143. x% = 22: COLOR 31, 4
  144. Center 1, SPACE$(20) + " ENTER NUMBER FOR LINE YOU WISH TO EDIT ══»"
  145. COLOR 0, 15: INPUT rn%
  146. IF rn% > TotRec% OR rn% < 1 THEN rn% = TotRec%
  147. GET #1, rn%, Easy
  148. DatInput
  149. EditOvl
  150. x% = 17: LOCATE x%, 6: Edit$ = Easy.Last: CALL GetEditor(Edit$)
  151. IF Edit$ <> "" THEN
  152.    LINE INPUT Easy.Last
  153.    IF LEFT$(UCASE$(Easy.Last), 3) = "ZZZ" THEN
  154.       Easy.Last = "zzz{del}" + LEFT$(Edit$, 7)
  155.       PUT #1, rn%, Easy
  156.       RETURN DispName
  157.    END IF
  158. END IF
  159. LOCATE x%, 36: Edit$ = Easy.First: CALL GetEditor(Edit$)
  160.    IF Edit$ <> "" THEN LINE INPUT Easy.First
  161. Spot 2, 6: Edit$ = Easy.Addr: CALL GetEditor(Edit$)
  162.    IF Edit$ <> "" THEN LINE INPUT Easy.Addr
  163. Spot 2, 6: Edit$ = Easy.City: CALL GetEditor(Edit$)
  164.    IF Edit$ <> "" THEN LINE INPUT Easy.City
  165. LOCATE x%, 31: Edit$ = Easy.State: CALL GetEditor(Edit$)
  166.    IF Edit$ <> "" THEN LINE INPUT Easy.State
  167. LOCATE x%, 46: Edit$ = Easy.Zip: CALL GetEditor(Edit$)
  168.    IF Edit$ <> "" THEN LINE INPUT Easy.Zip
  169. Spot 2, 6: Edit$ = Easy.Remk: CALL GetEditor(Edit$)
  170.    IF Edit$ <> "" THEN LINE INPUT Easy.Remk
  171. Easy.CarrRetn = CHR$(13) + CHR$(10)
  172. PUT #1, rn%, Easy
  173. RETURN DispName
  174.  
  175. TextSearch:
  176. IF File$ = "cardssrt.dat" THEN GOSUB WrongFile
  177. COLOR 1, 3, 1: CLS : Bottom "«« YOU ARE IN SEARCH MODE »»"
  178. CaseSen% = 1
  179. DO WHILE RecFind% < 2
  180. RecFind% = 0
  181. LOCATE 24, 50: COLOR 0, 3: PRINT "] or Press <enter> to Quit";
  182. LOCATE 24, 2: LINE INPUT "Enter Text to Find ══» ["; Search$
  183. IF Search$ = "" THEN RETURN Menu
  184. CALL QSearch(Search$, CaseSen%, RecFind%)
  185. LOCATE 20, 1: COLOR 0, 3: PRINT SPACE$(400);
  186. IF RecFind% = 0 THEN
  187.    LOCATE 22, 30: PRINT "....Did not find .."; CHR$(34); Search$; CHR$(34)
  188. ELSE
  189.    LOCATE 21, 30: PRINT CHR$(34); Search$; CHR$(34); " Last Found in Record ";
  190.    COLOR 15, 1: PRINT rn%;
  191. END IF
  192. LOOP
  193.  
  194. DataPrint:
  195. GOSUB OpenFile
  196. PrintScrn
  197. LOCATE 15, 32: INPUT rn%: LOCATE 15, 64: INPUT LastNum%
  198. IF LastNum% > TotRec% THEN LastNum% = TotRec%
  199. x% = 17: COLOR 15, 4
  200. Center 1, "You Can Cancel Printing Now by Pressing <M>"
  201. COLOR 0, 3: Center 2, "DO YOU WANT A HEADING - <Y>es <N>o <M>enu"
  202. DO
  203. a$ = UCASE$(INPUT$(1))
  204.    SELECT CASE a$
  205.       CASE IS = "Y"
  206.          GOSUB PrinterSetUp
  207.          LOCATE 11, 1: COLOR 0, 3
  208.          p = (48 - LEN(Header$)) / 2
  209.          LPRINT TAB(p); CHR$(14); Header$
  210.          p = (76 - LEN(SubHead$)) / 2
  211.          LPRINT TAB(p); SubHead$
  212.          LPRINT
  213.          LineFeed = 1
  214.          pg = 1: EXIT DO
  215.       CASE IS = "N"
  216.          x% = 17: COLOR 1, 7
  217.          Center 1, "INDICATE STARTING PAGE NUMBER FOR YOUR PRINT-OUT"
  218.          Center 2, SPACE$(18) + "STARTING PAGE NUMBER IS » "
  219.          INPUT pg
  220.          GOSUB PrinterSetUp
  221.          LPRINT
  222.          EXIT DO
  223.       CASE IS = "M"
  224.          RETURN Menu
  225.       CASE ELSE
  226.    END SELECT
  227. LOOP WHILE INSTR("YNM", a$) = 0
  228.  
  229. DO WHILE rn% < LastNum% + 1
  230. LineCnt% = 53
  231. IF rn% <= 0 THEN rn% = 1
  232.    FOR rn% = rn% TO rn% + 8
  233.       IF INKEY$ = CHR$(27) THEN EXIT DO
  234.       LineCnt% = LineCnt% - 4
  235.       IF rn% > LastNum% THEN EXIT DO
  236.       GET #1, rn%, Easy
  237.       PRINT TAB(6); RTRIM$(Easy.Last); ",  "; Easy.First
  238.       PRINT CHR$(13)
  239.       LPRINT TAB(12); RTRIM$(Easy.Last); ", "; Easy.First
  240.       LPRINT TAB(12); Easy.Addr
  241.       LPRINT TAB(12); RTRIM$(Easy.City); ", "; Easy.State; ", "; Easy.Zip
  242.       LPRINT TAB(12); Easy.Remk
  243.       LPRINT CHR$(13)
  244.    NEXT
  245. GOSUB PageNumber: pg = pg + 1
  246. LOOP
  247. IF LineCnt% > 1 THEN
  248.    DO
  249.       LPRINT
  250.       LineCnt% = LineCnt% - 1
  251.    LOOP UNTIL LineCnt% < 1
  252. END IF
  253. CLOSE
  254. GOSUB PageNumber
  255. RETURN Menu
  256.  
  257. PageNumber:
  258. LPRINT CHR$(13)
  259. LPRINT CHR$(27); CHR$(71); : ' Bold
  260. LPRINT CHR$(27); CHR$(83); CHR$(1); : ' Ss
  261. LPRINT TAB(60); Page$; pg
  262. PRINT TAB(25); pg; " Pages Sent to Printer"
  263. LPRINT CHR$(27); CHR$(84); : ' Cancel Ss
  264. LPRINT CHR$(27); CHR$(72); CHR$(1); : ' Cancel Bold
  265. LPRINT CHR$(12)
  266. RETURN
  267.  
  268. PrinterSetUp:
  269. COLOR 0, 3: CLS : Frame 3, 8, 6, 1
  270. COLOR 20, 3: Center 4, "Make Sure Printer is on Line"
  271. Bottom "Press <Esc> to Abandon Printing"
  272. LPRINT CHR$(27); CHR$(73); CHR$(2); : 'LQ
  273. RETURN
  274.  
  275. DataSort:
  276. CLS : Bottom "LOADING RECORDS INTO MEMORY"
  277. CLOSE : OPEN "cards.dat" FOR RANDOM AS #1 LEN = LEN(Easy)
  278. TotRec% = LOF(1) \ LEN(Easy)
  279. FOR rn% = 1 TO TotRec%
  280.   GET #1, rn%, Alpha(rn%)
  281.   PRINT TAB(5); Alpha(rn%).Last; Alpha(rn%).First
  282. NEXT
  283. COLOR 0, 2: Frame 10, 14, 8, 3: Center 9, " « PLEASE WAIT FOR SORTING »"
  284. CALL AlphaSort
  285. AllRecords% = TotRec%
  286. CLOSE : OPEN "cardssrt.dat" FOR RANDOM AS #1 LEN = LEN(Easy)
  287. Bottom "WRITING RECORDS TO SORTED FILE"
  288. LOCATE 16, 1
  289. FOR rn% = 1 TO AllRecords%
  290.   PUT #1, rn%, Alpha(rn%)
  291.   PRINT TAB(30); Alpha(rn%).Last; Alpha(rn%).First
  292. NEXT
  293. CLOSE
  294. GOSUB PageAdvn
  295. RETURN
  296.  
  297. '=========U T I L I T I E S ======
  298. PageAdvn:
  299. LOCATE 25, 1: COLOR 7, 4: PRINT STRING$(80, 240);
  300. LOCATE 25, 6: COLOR 0, 2: PRINT "▌ Press <Esc> for MENU ▐";
  301. LOCATE 25, 45: COLOR 15, 1: PRINT "▌ Press <enter> to Continue ▐";
  302. DO WHILE K$ <> CHR$(251)
  303. K$ = INKEY$
  304. IF K$ = CHR$(13) THEN RETURN
  305. IF K$ = CHR$(27) THEN RETURN Menu
  306. LOOP
  307.  
  308. OpenFile:
  309. CLOSE : OPEN File$ FOR RANDOM AS #1 LEN = LEN(Easy)
  310. TotRec% = LOF(1) \ LEN(Easy)
  311. RecLen% = LEN(Easy)
  312. RETURN
  313.  
  314. SelectFile:
  315. FileSelectScrn
  316. DO:
  317. a$ = UCASE$(INPUT$(1))
  318.    SELECT CASE a$
  319.       CASE IS = "S"
  320.          File$ = "cardssrt.dat"
  321.       CASE IS = "U"
  322.          File$ = "cards.dat"
  323.       CASE ELSE
  324.    END SELECT
  325. LOOP WHILE INSTR("SU", a$) = 0
  326. RETURN Menu
  327.  
  328. WrongFile:
  329. WrongFileScrn
  330. GOSUB PageAdvn
  331. RETURN Menu
  332.  
  333. ErrorProc:
  334. COLOR 0, 3, 4: CLS : Frame 3, 16, 8, 3
  335. x% = 4
  336. SELECT CASE ERR
  337.    CASE 5, 13
  338.       Spot 2, 18: PRINT "* * * P R O G R A M M I N G   E R R O R * * *"
  339.       Spot 2, 18: PRINT "Illegal Function Call or Type Mismatch"
  340.    CASE 25, 68, 71
  341.       Spot 2, 18: PRINT "* * * D E V I C E    E R R O R * * *"
  342.       Spot 2, 18: PRINT "PRINTER or DISK DRIVE not ready or Not Available"
  343.    CASE 63, 64
  344.       Spot 2, 18: PRINT "* * *F I L E  or  R E C O R D   E R R O R * * *"
  345.       Spot 2, 18: PRINT "Bad Record Number, OR Bad File Name"
  346.    CASE ELSE:
  347. END SELECT
  348. Spot 2, 18: PRINT "* * ERROR NUMBER * * ╔═══» ";
  349. COLOR 15, 1: PRINT ERR: COLOR 0, 3
  350. Spot 2, 18: LINE INPUT "Press <ENTER> To Return to MENU....."; anyk$
  351. RESUME Menu
  352.  
  353. EndProgram:
  354.    COLOR 0, 3: SYSTEM
  355.  
  356. DEFINT A-Z
  357. '
  358. SUB AlphaSort STATIC
  359.  
  360. DIM s(100)
  361. v = 3: s(1) = 1: s(2) = TotRec%
  362. DO
  363.    DO
  364.       IF v = 1 THEN
  365.       EXIT SUB
  366.       ELSE
  367.          t = s(v - 2)
  368.       END IF
  369.       V9 = s(v - 2) + 1: J9 = s(v - 1)
  370.       IF V9 > J9 THEN
  371.          v = v - 2
  372.          EXIT DO
  373.       END IF
  374.       DO UNTIL V9 > J9
  375.          DO UNTIL Alpha(V9).Last + Alpha(V9).First > Alpha(t).Last + Alpha(t).First
  376.             V9 = V9 + 1
  377.             IF V9 > J9 THEN EXIT DO
  378.          LOOP
  379.       IF V9 > J9 THEN EXIT DO
  380.          DO UNTIL Alpha(J9).Last + Alpha(J9).First < Alpha(t).Last + Alpha(t).First
  381.             J9 = J9 - 1
  382.             IF V9 > J9 THEN EXIT DO
  383.          LOOP
  384.       IF V9 > J9 THEN EXIT DO
  385.          DO
  386.          SWAP Alpha(V9), Alpha(J9)
  387.          V9 = V9 + 1
  388.          J9 = J9 - 1
  389.             IF V9 > J9 THEN
  390.                GOTO FinalStep
  391.                ELSE
  392.                EXIT DO
  393.             END IF
  394.          LOOP
  395.    LOOP
  396.  
  397. FinalStep:
  398.       IF J9 < s(v - 2) THEN
  399.          J9 = s(v - 2)
  400.       END IF
  401.       IF V9 > s(v - 1) THEN
  402.          V9 = s(v - 1)
  403.       END IF
  404.    SWAP V9, J9
  405.    SWAP Alpha(t), Alpha(V9)
  406.    K9 = s(v - 2)
  407.    L9 = s(v - 1)
  408.    v = v - 2
  409.       IF V9 - K9 <= 0 THEN
  410.          IF L9 - J9 <= 0 THEN
  411.             EXIT DO
  412.          ELSE
  413.             s(v) = J9
  414.             s(v + 1) = L9
  415.             v = v + 2
  416.             EXIT DO
  417.          END IF
  418.       END IF
  419.       IF L9 - J9 <= 0 THEN
  420.          s(v) = K9
  421.          s(v + 1) = V9 - 1
  422.          v = v + 2
  423.          EXIT DO
  424.       END IF
  425.       IF V9 - K9 > L9 - J9 + 1 THEN
  426.          s(v) = K9
  427.          s(v + 1) = V9 - 1
  428.          s(v + 2) = J9
  429.          s(v + 3) = L9
  430.          v = v + 4
  431.          EXIT DO
  432.       END IF
  433.    s(v) = J9
  434.    s(v + 1) = L9
  435.    s(v + 2) = K9
  436.    s(v + 3) = V9 - 1
  437.    v = v + 4
  438.    EXIT DO
  439.    LOOP
  440. LOOP
  441. END SUB
  442.  
  443. DEFSNG A-Z
  444. SUB Bottom (Text$)
  445. LOCATE 25, 1: COLOR 14, 5: PRINT STRING$(80, 247);
  446. Text$ = "█▄▄ " + Text$ + " ▄▄█"
  447. p% = INT(82 - LEN(Text$)) / 2
  448. LOCATE 25, p%: COLOR 15, 2: PRINT Text$;
  449. LOCATE 1, 1: COLOR 0, 3
  450. END SUB
  451.  
  452. SUB Center (Down%, Text$)
  453. x% = x% + Down%
  454. p% = INT((82 - LEN(Text$)) / 2)
  455. LOCATE x%, p%: PRINT Text$;
  456. END SUB
  457.  
  458. SUB DatInput
  459. COLOR 1, 1, 8: CLS : Upper "D A T A   I N P U T   S C R E E N": Frame 3, 8, 4, 2
  460. Spot 13, 62: COLOR 15, 0: PRINT "Record  » "; rn%
  461. LOCATE x%, 6: COLOR 15, 4: PRINT "LAST NAME"; SPACE$(6)
  462. LOCATE x%, 36: PRINT "First Name, MI"; SPACE$(6)
  463. Spot 2, 6: PRINT "Address"; SPACE$(18): Spot 2, 6: PRINT "City"; SPACE$(8)
  464. LOCATE x%, 31: PRINT "State": LOCATE x%, 46: PRINT "Zip Code"; SPACE$(2)
  465. Spot 2, 6: PRINT "R E M A R K S"; SPACE$(37)
  466. x% = 17: LOCATE x%, 6: COLOR 1, 7: PRINT STRING$(15, 177)
  467. LOCATE x%, 36: PRINT STRING$(20, 177)
  468. Spot 2, 6: PRINT STRING$(25, 177): Spot 2, 6: PRINT STRING$(12, 177)
  469. LOCATE x%, 31: PRINT STRING$(2, 177): LOCATE x%, 46: PRINT STRING$(10, 177)
  470. Spot 2, 6: PRINT STRING$(50, 177)
  471. x% = 3: COLOR 0, 7
  472. END SUB
  473.  
  474. SUB EditOvl
  475. Upper "T H E   E D I T   S C R E E N"
  476. x% = 3: Center 1, "To Leave an Item Unchanged, Press <enter>"
  477. Center 1, "┌┤  To Correct an Item - Press <Esc> to Enable the EDITOR;  ├┐"
  478. Center 1, "└┤then type New Data - Press <Enter> - Repeat for each Field├┘"
  479. COLOR 1, 7
  480. Center 2, "To delete this record, EDIT in " + CHR$(34) + "ZZZ" + CHR$(34) + " as Last Name and Press <enter>"
  481. Spot 3, 26: COLOR 15, 1: PRINT RTRIM$(Easy.Last); ", "; Easy.First
  482. Spot 1, 26: PRINT Easy.Addr
  483. Spot 1, 26: PRINT RTRIM$(Easy.City); ",  "; Easy.State; ",  "; Easy.Zip
  484. Spot 1, 26: PRINT Easy.Remk
  485. Spot 3, 6: COLOR 1, 7: PRINT Easy.Last: LOCATE x%, 36: PRINT Easy.First
  486. Spot 2, 6: PRINT Easy.Addr: Spot 2, 6: PRINT Easy.City;
  487. LOCATE x%, 31: PRINT Easy.State; : LOCATE x%, 46: PRINT Easy.Zip
  488. Spot 2, 6: PRINT Easy.Remk
  489. END SUB
  490.  
  491. SUB FileSelectScrn
  492. COLOR 0, 1, 8: CLS : Upper " FILE SELECTION MENU ": Frame 3, 10, 4, 3
  493. Center 2, "Select <U>nsorted File for Searches, Editing, and Additions"
  494. Center 1, "Select <S>orted file for final Print-out of your card list"
  495. COLOR 0, 3: Center 3, " ▀ Choose <S> or <U>   «»   See Helpful Hints Below ▀ "
  496. COLOR 0, 7: Frame 13, 22, 2, 2
  497. Spot 12, 4
  498. PRINT "Your <U>nsorted file is your source data; therefore all additions, edits"
  499. Spot 1, 4
  500. PRINT "etc , must be made using <U>nsorted file.  The <S>orted file is recreated"
  501. Spot 1, 4
  502. PRINT "each time file is sorted;  and any changes to <S>orted file would be"
  503. Spot 1, 4
  504. PRINT "over-written by Sort."
  505. Spot 2, 4
  506. PRINT "Remember to sort file and then select <S>orted file for final print-out"
  507. Spot 1, 4
  508. PRINT "of Card List."; ""
  509. END SUB
  510.  
  511. SUB Frame (Row%, LRow%, Col%, Box%)
  512. ss% = INT(80 - (2 * Col%))
  513. SELECT CASE Box%
  514.    CASE 1
  515.       LOCATE Row%, Col%: PRINT CHR$(218); STRING$(ss%, 196); CHR$(191)
  516.       Side% = 179: GOSUB SideLines
  517.       LOCATE Row%, Col%: PRINT CHR$(192); STRING$(ss%, 196); CHR$(217);
  518.    CASE 2
  519.       LOCATE Row%, Col%: PRINT CHR$(201); STRING$(ss%, 205); CHR$(187)
  520.       Side% = 186: GOSUB SideLines
  521.       LOCATE Row%, Col%: PRINT CHR$(200); STRING$(ss%, 205); CHR$(188);
  522.    CASE 3
  523.       LOCATE Row%, Col%: PRINT CHR$(219); STRING$(ss%, 223); CHR$(219)
  524.       Side% = 219: GOSUB SideLines
  525.       LOCATE Row%, Col%: PRINT CHR$(219); STRING$(ss%, 220); CHR$(219);
  526.    CASE 6
  527.       Row% = Row% + 1: LRow% = LRow% + 2: Col% = Col% + 2
  528.       FOR Row% = Row% TO LRow%: LOCATE Row%, Col%
  529.       PRINT STRING$(ss% + 2, 219): NEXT
  530.    CASE ELSE
  531. END SELECT
  532. x% = 3
  533. EXIT SUB
  534.  
  535. SideLines:
  536. FOR Row% = Row% + 1 TO LRow%: LOCATE Row%, Col%:
  537. PRINT CHR$(Side%); SPACE$(ss%); CHR$(Side%): NEXT
  538. RETURN
  539. END SUB
  540.  
  541. SUB GetEditor (Edit$)
  542. x% = CSRLIN
  543. p% = POS(0)
  544. ss% = LEN(Edit$)
  545. LOCATE x%, p%: COLOR 7, 0: PRINT Edit$
  546. LOCATE x%, p%
  547. DO
  548.    K$ = INKEY$
  549.    IF K$ = CHR$(13) THEN
  550.       COLOR 0, 7: PRINT Edit$
  551.       Edit$ = ""
  552.       EXIT SUB
  553.    END IF
  554. LOOP WHILE K$ <> CHR$(27)
  555.    IF K$ = CHR$(27) THEN
  556.       COLOR 15, 4: PRINT SPACE$(ss%)
  557.       LOCATE x%, p%, 1
  558.    END IF
  559. END SUB
  560.  
  561. SUB HelpFile
  562. COLOR 0, 3, 0: CLS : Frame 3, 4, 12, 1
  563. Center 1, "W O R K I N G"
  564. HelpText = FREEFILE
  565. OPEN "cards.hlp" FOR BINARY AS HelpText
  566. Size = LOF(HelpText)
  567. Help$ = STRING$(Size, 32)
  568. GET HelpText, , Help$
  569. CLOSE HelpText
  570.  
  571. DO
  572. m% = 1
  573.    DO
  574.       CLS
  575.       FOR x% = 1 TO 25: LOCATE x%, 1: PRINT MID$(Help$, m%, 80);
  576.          m% = m% + 80
  577.       NEXT
  578.       DO
  579.          K$ = UCASE$(INKEY$)
  580.          IF K$ = CHR$(27) THEN EXIT SUB
  581.          IF K$ = CHR$(13) OR K$ = "T" THEN EXIT DO
  582.       LOOP
  583.       IF K$ = "T" THEN EXIT DO
  584.       IF m% >= Size THEN EXIT SUB
  585.    LOOP
  586. LOOP
  587. END SUB
  588.  
  589. SUB Logon
  590. COLOR 1, 0, 1: CLS : Bottom "Copyright 1990 by George A. Jones"
  591. COLOR 8: Frame 5, 20, 10, 6: COLOR 0, 2: Frame 5, 20, 10, 3
  592. COLOR 0, 4: Frame 7, 17, 16, 3: COLOR 2, 7: Frame 9, 15, 21, 2
  593. COLOR 0, 7: Center 7, "VIOLA AND GEORGE JONES"
  594. COLOR 4, 2: Center 2, "█▒█▒█▒█▒█▒█"
  595. COLOR 0, 7: Center 2, "RECORD OF CHRISTMAS CARDS"
  596. SLEEP (5)
  597. END SUB
  598.  
  599. SUB MenuScrn
  600. COLOR 1, 2, 4: CLS : Bottom "Version 1.1": COLOR 2, 7: Frame 1, 2, 1, 2
  601. x% = 1: COLOR 4, 7: Center 1, "CHRISTMAS CARD MAILING LIST"
  602. COLOR 8: Frame 5, 18, 6, 6: COLOR 1, 3: Frame 5, 18, 6, 3
  603. COLOR 11, 3: Frame 7, 8, 16, 1
  604. COLOR 0, 3: Center 5, "P R O G R A M   S E L E C T I O N "
  605. p% = 12
  606. Spot 4, p%: COLOR 0, 3: PRINT "<C>reate or Add to Card File "
  607. LOCATE x%, 44: PRINT "<F>ile Selection Menu"
  608. Spot 2, p%: PRINT "<L>ist, Search, Sort Records"
  609. LOCATE x%, 44: PRINT "(P>rint The Card List"
  610. Spot 2, p%: PRINT "<H>elp Screen Display"
  611. LOCATE x%, 46: PRINT " e<X>it The Program"
  612. x% = 10: p% = 13
  613. Spot 2, p%: COLOR 14, 3: PRINT "C": LOCATE x%, 45: PRINT "F"
  614. Spot 2, p%: PRINT "L": LOCATE x%, 45: PRINT "P"
  615. Spot 2, p%: PRINT "H": LOCATE x%, 49, 0: PRINT "X"
  616. COLOR 2, 7: Frame 22, 23, 1, 2
  617. COLOR 4, 7: Center 20, " SELECT  C - H - L - P - S - or - X "
  618. END SUB
  619.  
  620. SUB PrintScrn
  621. COLOR 0, 1, 8: CLS : Upper " Printer Instructions for  " + File$
  622. Frame 3, 21, 4, 1: Center 19, "┤ Select Names to Print ├"
  623. x% = 4: Center 1, "SIZE OF PRINT FILE IS" + STR$(TotRec%) + " RECORDS"
  624. Center 2, "╟─THERE WILL BE 9 RECORDS TO EACH PAGE─╢"
  625. Spot 2, 10: COLOR 0, 2: PRINT "RECORDS 1 TO 90 WILL BE TEN PAGES"
  626. Spot 2, 10: PRINT "LINES 91 TO 180 IS TWENTY PAGES"
  627. Spot 2, 10: PRINT "LINES 181 TO 270 IS THIRTY PAGES"
  628. COLOR 0, 7
  629. Center 2, "Start Print at Record [        ] ▐  End Print at Record [        ]"
  630. END SUB
  631.  
  632. SUB QSearch (Search$, CaseSen%, RecFind%)
  633. CLOSE : OPEN "cards.dat" FOR BINARY AS 1
  634. FileSize! = LOF(1)
  635. Size! = FRE("") / 3
  636. IF Size! > 32000 THEN Size! = 32000
  637. Size! = INT(Size! / RecLen%) * RecLen%
  638. Pass% = FileSize! / Size!
  639. IF FileSize! / Size! > INT(Pass%) THEN Pass% = Pass% + 1
  640.    FOR r% = 1 TO Pass%
  641.       BgnRec% = 1
  642.       Text$ = SPACE$(Size!)
  643.       GET #1, , Text$
  644.       GOSUB SearchRecord
  645.       Text$ = ""
  646.    NEXT r%
  647. CLOSE 1
  648.  
  649. EXIT SUB
  650.  
  651. SearchRecord:
  652. DO
  653. NextRecord = 0
  654. IF CaseSen% = 1 THEN
  655.    MemAddr% = INSTR(BgnRec%, UCASE$(Text$), UCASE$(Search$))
  656. ELSE
  657.    MemAddr% = INSTR(BgnRec%, Text$, Search$)
  658. END IF
  659. IF MemAddr% > 0 THEN
  660.    RecFind% = 1
  661.    Place% = (MemAddr% \ RecLen%) * RecLen% + 1
  662.    rn% = ((Size! / RecLen%) * r%) - ((Size! - Place%) \ RecLen%)
  663.    Cnt% = Cnt% + 1
  664.    Record$ = MID$(Text$, Place%, RecLen% - 2)
  665.    VIEW PRINT 10 TO 19: LOCATE 19, 80: PRINT : PRINT : PRINT : VIEW PRINT
  666.    LOCATE 20, 2: COLOR 0, 7: PRINT " Text Found in Record:";
  667.         COLOR 15, 0: PRINT rn%;
  668.    LOCATE 20, 50: COLOR 15, 1: PRINT Cnt%;
  669.         COLOR 0, 3: PRINT " Record(s) Found ";
  670.    LOCATE 21, 10: PRINT "╚═»...Press <enter> to continue Search.";
  671.    LOCATE 22, 23: PRINT "...OR ... or Press <Esc> for next SEARCH ";
  672.    Flash$ = MID$(Text$, MemAddr%, LEN(Search$))
  673.    FlashCol% = MemAddr% - Place% + 1
  674.    FlashRow% = 18
  675.       DO WHILE FlashCol% > 80
  676.            FlashCol% = FlashCol% - 80
  677.            FlashRow% = FlashRow% + 1
  678.       LOOP
  679.    LOCATE 17, 2: PRINT Record$;
  680.    COLOR 21, 7: LOCATE FlashRow%, FlashCol%: PRINT Flash$;
  681.    COLOR 0, 3
  682.    DO WHILE K$ <> CHR$(251)
  683.       K$ = INKEY$
  684.       IF K$ = CHR$(13) THEN
  685.          BgnRec% = Place% + RecLen% - 1
  686.          LOCATE 17, 2: PRINT Record$
  687.          NextRecord = 1
  688.          EXIT DO
  689.    END IF
  690.       IF K$ = CHR$(27) THEN
  691.          LOCATE 17, 2: PRINT Record$
  692.          CLOSE 1
  693.          EXIT SUB
  694.       END IF
  695.    LOOP
  696. END IF
  697. LOOP WHILE NextRecord = 1
  698. RETURN
  699. END SUB
  700.  
  701. SUB Spot (Down%, Over%)
  702. x% = x% + Down%: LOCATE x%, Over%
  703. END SUB
  704.  
  705. SUB Upper (Text$)
  706. LOCATE 1, 1: COLOR 14, 4: PRINT STRING$(80, 196);
  707. Text$ = "┤" + Text$ + "├"
  708. p% = INT(82 - LEN(Text$)) / 2
  709. LOCATE 1, p%: PRINT Text$
  710. COLOR 0, 7
  711. END SUB
  712.  
  713. SUB WrongFileScrn
  714. COLOR 0, 0, 1: CLS : COLOR 0, 7: Frame 3, 20, 4, 2
  715. COLOR 15, 1: Center 2, "You may be trying to use Wrong File"
  716. COLOR 0, 7: Center 2, "Please use <U>nsorted File for Additions"
  717. Center 1, "for Searches, and for Edits and Deletions."
  718. Center 2, "Use <S>orted File for print-out of your final list. It may be"
  719. Center 1, "necessary to use <L>ist, Search, Sort function to create"
  720. Center 1, "<S>orted file, if file has not been sorted."
  721. Center 2, "Please return to MENU and use <F>ile Selection Feature"
  722. Center 1, "to Choose correct file."
  723. COLOR 1, 7: Center 4, "[ Please See Helpful Hints at File Selection Menu ]"
  724. END SUB
  725.  
  726.